home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rdblib / rbscrn.frm < prev    next >
Text File  |  1995-05-02  |  3KB  |  109 lines
  1. VERSION 2.00
  2. Begin Form RBScrn 
  3.    BorderStyle     =   0  'None
  4.    Caption         =   "Current Screen Print"
  5.    ClientHeight    =   4020
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1485
  8.    ClientWidth     =   7365
  9.    ControlBox      =   0   'False
  10.    Height          =   4425
  11.    HelpContextID   =   39
  12.    Left            =   1035
  13.    LinkTopic       =   "Form2"
  14.    MaxButton       =   0   'False
  15.    MinButton       =   0   'False
  16.    MousePointer    =   11  'Hourglass
  17.    ScaleHeight     =   4020
  18.    ScaleWidth      =   7365
  19.    Top             =   1140
  20.    Width           =   7485
  21.    WindowState     =   2  'Maximized
  22.    Begin PictureBox Picture1 
  23.       AutoRedraw      =   -1  'True
  24.       BorderStyle     =   0  'None
  25.       Height          =   4035
  26.       Left            =   0
  27.       ScaleHeight     =   4035
  28.       ScaleWidth      =   7395
  29.       TabIndex        =   0
  30.       Top             =   0
  31.       Visible         =   0   'False
  32.       Width           =   7395
  33.    End
  34. End
  35. Dim ljunk As Integer
  36.  
  37. Sub Form_Activate ()
  38.     mousepointer = HOURGLASS
  39.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_HIDE)
  40.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_HIDE)
  41.     ljunk = ShowWindow(RBScrn.hWnd, SW_HIDE)
  42.     DoEvents
  43.     mousepointer = HOURGLASS
  44.     GrabScreen
  45.  
  46.     mousepointer = HOURGLASS
  47.     ljunk = ShowWindow(RBScrn.hWnd, SW_SHOW)
  48.     RBScrn.WindowState = MAXIMIZED
  49.     DoEvents
  50.     RBScrn.PrintForm
  51.     ljunk = ShowWindow(RBProbRpt.hWnd, SW_SHOW)
  52.     ljunk = ShowWindow(RBErrFrm.hWnd, SW_SHOW)
  53.     Unload RBScrn
  54.  
  55. End Sub
  56.  
  57. Sub GetTwipsPerPixel ()
  58.     ' Set a global variable with the Twips to Pixel ratio.
  59.     RBScrn.ScaleMode = 3
  60.     NumPix = RBScrn.ScaleHeight
  61.     RBScrn.ScaleMode = 1
  62.     TwipsPerPixel = RBScrn.ScaleHeight / NumPix
  63. End Sub
  64.  
  65. Sub GrabScreen ()
  66.  
  67.     Dim winSize As lrect
  68.  
  69.     ' Assign information of the source bitmap.
  70.     ' Note that BitBlt requires coordinates in pixels.
  71.     hwndSrc% = GetDesktopWindow()
  72.     hSrcDC% = GetDC(hwndSrc%)
  73.     XSrc% = 0: YSrc% = 0
  74.     Call GetWindowRect(hwndSrc%, winSize)
  75.     nWidth% = winSize.right             ' Units in pixels.
  76.  
  77.     nHeight% = winSize.bottom           ' Units in pixels.
  78.  
  79.     ' Assign informate of the destination bitmap.
  80.     hDestDC% = RBScrn.Picture1.hDC
  81.     x% = 0: Y% = 0
  82.  
  83.     ' Set global variable TwipsPerPixel and use to set
  84.     ' picture box to same size as screen being grabbed.
  85.     ' If picture box not the same size as picture being
  86.     ' BitBlt'ed to it, it will chop off all that does not
  87.     ' fit in the picture box.
  88.     GetTwipsPerPixel
  89.     RBScrn.Picture1.Top = 0
  90.     RBScrn.Picture1.Left = 0
  91.     RBScrn.Picture1.Width = (nWidth% + 1) * TwipsPerPixel
  92.     RBScrn.Picture1.Height = (nHeight% + 1) * TwipsPerPixel
  93.  
  94.     ' Assign the value of the constant SRCOPYY to the Raster operation.
  95.  
  96.     dwRop& = &HCC0020
  97.  
  98.     ' Note function call must be on one line:
  99.     Suc% = BitBlt(hDestDC%, x%, Y%, nWidth%, nHeight%, hSrcDC%, XSrc%, YSrc%, dwRop&)
  100.  
  101.     ' Release the DeskTopWindow's hDC to Windows.
  102.     ' Windows may hang if this is not done.
  103.     Dmy% = ReleaseDC(hwndSrc%, hSrcDC%)
  104.  
  105.     'Make the picture box visible.
  106.     RBScrn.Picture1.Visible = True
  107. End Sub
  108.  
  109.